perm filename CODE4.F4[P11,LCS]1 blob
sn#573346 filedate 1981-03-22 generic text, type T, neo UTF8
00100 C TITLE ITMSUB
00200 C INTERNAL ITMSUB
00300 C EXTERNAL BM,NOZERO,LINX,ROFF,CENTX,STF,LINES,.COMM.
00400 C EXTERNAL DAT,RHORZ,CLEFS,PLTR,MIN,POSI,ALF,RDRAW,OLDTOP
00500 C DEFINE R9 <.COMM.+=10 >↔ DEFINE R8<.COMM.+=9 >
00600 C DEFINE J2 <.COMM.+3 >↔ DEFINE J10 <.COMM.+=31 >
00700 C DEFINE J7 <.COMM.+=28 >
00800 SUBROUTINE ITMSUB
00900 IMPLICIT INTEGER(A-Q,S-Z)
01000 REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1,XDIS
01100 COMMON/STF/RSTFAC(0/7),RSTJ2/MIN/MINI,RMINI
01200 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(16),RE,RF,RG,RH/BM/RA,RC,RJY
01300 COMMON/POSI/STFF(0/7),JJ2,POS/PLTR/PLT,RHT,DIS,XDIS
01400 COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
01500 1 RJA,YY,DISX,HGT,RZ,INP(53) /OLDTOP/OLDY
01600 COMMON/DAT/RACNT(65),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
01700 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),(R11,
01800 1RJQ(9)),(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01900 1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
02000 1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,RJQ(20))
02100 DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
02200 1,RDBR/ 3.5/,RBR/.33/,RBX/ 7.0/
02300 C RDBR IS SPACER FOR DBL BAR.
02400 RST7=RSTJ2*7.
02500 RST18=RSTJ2*18.
02600 C TO COMPENSATE FOR NOTE #3 COMING AT POS=0
02700 R3Q=R3
02800 C NEXT DRAWS STRAIGHT LINES
02900 RD=R4*RST7
03000 RA=0
03100 RX=RTF*RSTJ2+POS
03200 J10=J10*DIS*RSTJ2
03300 C THICKNESS DEPENDS ON FINAL SIZE FACTOR (DIS) AND STAFF SIZE.(???!!)
03400 IF(J5.EQ.50.OR.J5.EQ.150)GO TO 300
03500 C 150 IS FOR 'PARTS' FEATURE - PUTS CRESC. IN ALL.
03600 IF(R6.NE.0)GO TO 401
03700 IF(J7.NE.0)GO TO 401
03800 C FOR BAR LINES
03900 4000 JA=44
04000 C CODE # IS CHNGD SO BAR LINES WON'T AFFECT MAX. HGT.
04100 C ↑↑↑↑↑↑↑↑↑ FOR VERTICAL WIGGLE (P6=0, P7=-1)
04200 DBR=0
04300 IF(J4.LT.1000)GO TO 400
04400 C J4=1001 = DBL BAR, =1401 = DBL BAR WITH RT. ONE HEAVY: J5=1=DOTS ADDED
04500 DBR=J4/1000
04600 IF(J5.NE.0)GO TO 1
04700 IF(DBR.LT.2)GO TO 1
04800 J5=1
04900 IF(DBR.EQ.4)DBR=1
05000 C FOR REPEAT DBL.BAR WITH P5=0
05100 C P4=2000=DOTS ON RIGHT, =3000=BOTH SIDES
05200 C =4000=DOTS ON LEFT
05300
05400 1 J4=J4-DBR*1000
05500 C DBR=1 HEAVY BAR IS ON R
05600 9400 RD=RDBR+RDBR*RSTJ2
05700 C TO SPACE THIN BAR FROM HEAVY
05800 IF(J5.EQ.0)GO TO 400
05900 C NEXT ADDS REPEAT DOTS TO DBL BAR.
06000 L=J4
06100 RJ=L/100
06200 IF(RJ.EQ.0)RJ=6.*RSTJ2
06300 C HEAVY BAR WILL BE 5 LINES WIDE.
06400 RZ=R3
06500 J4=0
06600 C MUST BE 0 FOR DOTS IN 'NOTWRT'
06700 IF(DBR.NE.0)GO TO 2
06800 IF(J5.GT.3)J5=3
06900 DBR=J5
07000 J5=0
07100 C J5=1 RPT ↑, =2 RPT ↑, =3 RPT ↑
07200 RJA=RD*2.
07300 C TO SPACE DOTS, NOT ACCURATE FOR VERY SMALL OR VERY LARGE SIZE FACTORS
07400 JY=DBR
07500 IF(DBR.LT.2)GO TO 8400
07600 R3=RJA+RJ+RZ
07700 7400 DO 3400 K=J2,MOD(L,100)+J2-1
07800 4 RSTJ2=RSTFAC(K)
07900 POS=STFF(K)
08000 R4=6
08100 CALL CENTX
08200 C SPACES DOTS OUT FROM BAR
08300 CALL RDRAW(1,17.0,RDOT(4),RSTJ2,R3,CENTR+RSTJ2,RSTJ2)
08400 C /DAT/+=69 ;EXTENDED FOR +65 TO +69 1/78
08500 C GO GET THE DOT
08600 R4=8
08700 CALL CENTX
08800 3400 CALL RDRAW(1,17.0,RDOT(4),RSTJ2,R3,CENTR+RSTJ2,RSTJ2)
08900 JY=JY-1
09000 IF(JY.LT.2)GO TO 4400
09100 8400 R3=RZ-RJA-4.*RSTJ2
09200 GO TO 7400
09300 C DO I NEED ANY MORE RESETS????
09400 4400 J4=L
09500 J7=RJ*DIS
09600 GO TO 5400
09700 400 IF(J5.NE.0)GO TO 9400
09800 K=J4/100
09900 C K IS FOR SPACING OF THIN BAR IN HEAVY-THIN ORDER
10000 J7=K*DIS
10100 C J7=NUM OF STROKES -- BASED ON FINAL SIZE FACTOR (DIS)
10200 C5400 L=MOD(J4,100)
10300 C IF(J4.LT.0)J4=0
10400 C ABOVE FOR INVIS. BARS (AT PRINT TIME)
10420 5400 L=J4
10440 IF(L.LT.0)L=0
10460 L=MOD(L,100)
10480 IF(L.NE.0)L=L-1
10500 L=L+J2
10800 C L=L+J2-1
11100 C J4=401 MAKES 4X THICK BARLINE - ONE STAFF
11200 RA=RTF
11500 IF(L.LE.7)GO TO 2400
11600 L=7
11700 RA=300.
11900 C FOR EXTENDING BARS ABOVE STAFF 7
12100 2400 OLDY=RSTFAC(L)
12300 C SAVE IT FOR DBL RPT BAR.
12320 RZ=R3Q
12400 OLDY=STFF(L)+(RA+56.)*OLDY
12800 1400 RA=1
13000 IF(PLT.GE.0)GO TO 140
13100 IF(J4.LT.0)RETURN
13200 J7=J7+1
13400 C DON'T PRINT INVIS BARS. (USED BY 'PAGE')
13700 RA=XDIS
13800 C BAR LINES PLOT AS DOUBLE THICKNESS
14000 140 RJX=R3Q
14100 42 CALL LINES(R3Q,RX,3)
14500 RJ=-1.
14700 RW=OLDY
14900 406 CALL LINES(RJX,OLDY,2)
15300 IF(J10.EQ.0)GO TO 411
15500 C P10 WILL THICKEN VERTICAL (OR MOSTLY VERTICAL) LINES.
15600 J7=J10
15700 J10=0
15900 RA=XDIS
16000 411 IF(J7.GT.0)GO TO 409
16300 IF(DBR.LE.0)RETURN
16400 OLDY=RW
16600 RA=RZ-RD
16800 IF(DBR.NE.1)RA=RJX+RD-1.
17500 R3Q=RA
17600 DBR=DBR-2
17800 GO TO 1400
18000
18100 409 IF(R6.EQ.0)GO TO 1402
18150 C FOR 'HEAVY' LINE.
18200 C P10 = NUM. OF ADDITIONAL LINES.
18300 C ****** ONLY GOOD FOR SLOPE OF LESS THAN 45 DEG.
18400 J7=J7-1
18500 J10=J7
18600 C GET SHIFT INCREMENT (DEPENDS ON FINAL SIZE)
18700 RR=ABS(RX-OLDY)
18800 C RR HAS AMOUNT OF Y SHIFT IN LINE
18900 RQ=ABS(R3Q-RJX)
19100 C RQ HAS AMOUNT OF X SHIFT IN LINE
19200 RQ=RQ-RR
19300 IF(RQ.GE.0)GO TO 1402
19500 C MOVE RIGHT ONE SCAN LINE FOR NEXT VECTOR
19550 R3Q=R3Q+RA
19600 C R3Q AND RJX ARE THE 2 X COORDS.
19700 GO TO 42
19750 1402 RX=RX+RA
19800 C MOVE UP ONE SCAN LINE FOR NEXT VECTOR
19850 OLDY=OLDY+RA
19900 C RX AND OLDY ARE THE 2 Y COORDS.
19950 GO TO 42
20000 C GO DRAW IT
20100
20200 402 RJX=RJX+RA
20250 C HEAVIER BAR LINES
20300 CALL LINES(RJX,OLDY,2)
20700 J7=J7-1
20800 OLDY=RW
21000 IF(RJ.LT.0)OLDY=RX
21200 RJ=-RJ
21400 GO TO 406
21500 C DRAWS BAR LINES. J4>0 CAUSES FULL LINE.
21600 C FOR CRESC., DECRESC.
21700 300 IF(R7.EQ.0)R7=2.3
22400 IF(R7.EQ.-1.)R7=-2.3
22500 RA=ABS(R7/2.0)*RST7
22800 C AMOUNT OF SPREAD
22900 RJ=R3Q
23000 RX=RX-RST18+RD
23300 IF(R8.NE.0)GO TO 302
23500 C JUMP TO MAKE BOX
23600 R6=RHORZ(R6)
23800 IF(R7.LT.0)GO TO 301
24000 RJ=R6
24100 R6=R3Q
24200 301 CALL LINX(RJ,RA+RX,R6,RX)
24300 CALL LINES(RJ,RX-RA,2)
25500 C FOR CRESC, DECRESC:4 POS1, STF, HGT, 50, POS1, +OR-N(0=2.3,-1=-2.3)
25600 IF(PLT.GE.0)RETURN
25800 C THIS MAKES ALL CRESC. DBL THICKNESS AT PRINT TIME.
25900 IF(J8.LT.0)RETURN
26000 RX=RX+XDIS
26200 J8=-1
26300 C FOR DOUBLE THICKNESS
26400 GO TO 301
26600 302 R8=R8*RST7
26700 R9=R9*RST7
26900 IF(R9.EQ.0)R9=R8
27200 C R9=0 MAKES SQUARE
27300 R3=R3Q-R8/2.
27600 RX=RX-R9/2.
27900 OLDY=RX
28000 IF(R11.NE.0)OLDY=OLDY+R11*RST7
28400 C R11 IS OFFSET FOR PARALLELAGRAM
28600 C DRAWS BOX, CENTER IS IN MIDDLE
28700 C 4,POSI+=9,STF,NT#,50,0,0,,SIZ1↑BY NT#S↑,SIZ2
28800 1302 CALL LINX(R3,RX,R3+R8,OLDY)
29400 CALL LINES(R3+R8,OLDY+R9,2)
30200 CALL LINES(R3,RX+R9,2)
30800 CALL LINES(R3,RX,2)
31300 IF(J10.EQ.0)RETURN
31500 J10=J10-1
31600 RJ=XDIS
31800 R3=R3-RJ
32000 R8=R8+RJ+RJ
32200 RX=RX-RJ
32300 OLDY=OLDY-RJ
32400 R9=R9+RJ+RJ
32500 GO TO 1302
32600 C TO THICKEN BOXES.
32650 1401 R4=2.0
32800 C FOR HEAVY BRACK.
32900 RA=RST7
33100 RX=RX-RA
33200 C THE BOTTOM
33300 L=J4+J2-1
33600 R6=RTF
33700 IF(L.LE.7)GO TO 4401
33900 L=7
34000 R6=300.
34100 4401 RA=STFF(L)
34200 C SAVE FOR POS. OF BRACK. END ON UPPER STAFF.
34300 RJY=RSTFAC(L)
34400 OLDY=RA+(R6+63.)*RJY
34700 FADR 3,BM
34800 MOVEM 3,OLDTOP ; 20900 C THE TOP
34900 MOVSI 02,204460 ; 21000 R5=9.5
35000 MOVEM 02,.COMM.+6 ;21100 GO TO 2401
35100 JRST I2401 ; 21300 C DASHES
35200 I401: MOVN 02,ALF+4 ; 21400 401 POS=POS-RST18
35300 FADRM 02,POSI+=9 ; 21600 IF(J7.LE.0)GO TO 407
35400 MOVE 02,.COMM.+=28
35500 JUMPLE 02,I407
35600 CAIN 2,4 ; 21700 IF(J7.EQ.4)GO TO 1401
35700 JRST I1401
35800 CAIE 2,3 ; 21800 IF(J7.NE.3)GO TO 4001
35900 JRST I4001
36000 ;21900 NEXT IS FOR VARIABLE LARGE BRACKET. P7=3 P10=THICK. P5=HGT P6=P3
36100 I2401: MOVEI 02,3 ; 22000 2401 JA=3
36200 MOVEM 02,.COMM.+1 ;22100 IF(J10.EQ.0)J10=4
36300 MOVE 02,J10
36400 JUMPN 02,.+5
36500 MOVSI 02,203600 ;6.0
36600 FMPR 2,PLTR+2 ;*DIS THICKNES FOLLOWS PLOTTER SIZE
36700 FMPR 2,STF+=8 ;*RSTJ2 AND STAFF SIZE
36800 KIFIX 2,2
36900 MOVEM 02,J10 ; DEFAULT VALUE FOR THICKNESS =4*SIZE FACT.
37000 MOVN 02,[0.33] ; 22300 R4=R4-RBR
37100 FADRM 02,.COMM.+5 ;22400 J9=0
37200 SETZM .COMM.+=30 ; 22500 J5=35
37300 MOVEI 02,43
37400 MOVEM 02,.COMM.+=26 ;22600 C THE NUM FOR THE LITTLE END ITEMS
37500 MOVSI 02,202600 ; 22800 R6=3
37600 MOVEM 02,.COMM.+7 ;22900 R7=0
37700 SETZM .COMM.+=8;DOES LOWER ONE FIRST. ITEM IS IN 'CLEFC.DMD' ON DAT.LCS
37800 SETZM R8 ;R8 MUST BE 0 FOR CLEFS (ELSE IT ACTIVATES THICKENER)
37900 MOVE 02,.COMM.+=29 ; 23100 IF(J8.NE.2)CALL CLEFS
38000 MOVEM 2,RH ;SAVE J8 IN RH (J8 WIPED OUT IN CLEFS)
38100 CAIE 02,2
38200 JSA 16,CLEFS ;P8=1=BOTTOM 1/2 BRACK. ONLY: =2=TOP 1/2 ONLY: 0=COMPLETE
38300 MOVN 3,[0.33] ;23300 R4=R5-RBR
38400 FADR 3,.COMM.+6
38500 MOVEM 3,.COMM.+5 ; 23400 R6=3
38600 MOVSI 02,202600
38700 MOVEM 02,.COMM.+7 ;23500 R7=-3
38800 MOVNM 02,.COMM.+=8 ;23600 C TURNS IT UPSIDE DOWN.
38900 MOVEI 02,4 ;23800 IF(J7.NE.4)GO TO 3401
39000 CAME 02,.COMM.+=28
39100 JRST I3401 ; 23900 POS=RA
39200 MOVE 02,BM
39300 MOVEM 02,POSI+=9 ; 24000 R4=R4*RJY/RSTJ2
39400 FMPR 3,BM+2
39500 FDVR 3,STF+=8
39600 MOVEM 3,.COMM.+5 ;TO ADJUST HEIGHT OF BRACK END WHEN STAVES ARE DIFF. SIZES.
39700 I3401: MOVEI 02,1 ; 24200 3401 IF(J8.NE.1)CALL CLEFS
39800 CAME 02,RH ; RH IS CURRENTLY J8 (INTEGER I.E.)
39900 JSA 16,CLEFS ;24300 R3Q=R3Q-12.0*RSTJ2
40000 MOVSI 02,204600
40100 FMPR 02,STF+=8
40200 FSBRM 02,ALF+5
40300 MOVNS 00,ALF+5 ; 24400 IF(J7.NE.4)GO TO 407
40400 MOVEI 02,4
40500 CAME 02,.COMM.+=28
40600 JRST I407 ; 24500 J7=0
40700 SETZM .COMM.+=28 ; 24600 GO TO 140
40800 JRST I140 ; 24800 4002 J5=5
40900 I4002: MOVEI 02,5 ;FOR CURVY BRACKET. P8 CAN CHANGE WIDTH.
41000 MOVEM 02,.COMM.+=26 ; 25100 J4=J4+J2-1
41100 MOVNI 3,1
41200 ADD 3,.COMM.+3
41300 ADDB 3,.COMM.+=25 ;R7=(.3136*RSTFAC(J4)+.0056*(STFF(J4)-STFF(J2)))/RSTJ2
41400 MOVE 02,[0.3136]
41500 FMPR 02,STF(3)
41600 MOVE 04,POSI(3)
41700 MOVE 03,J2
41800 FSBR 04,POSI(3)
41900 FMPR 04,[0.0056]
42000 FADR 02,4
42100 FDVR 02,STF+=8
42200 MOVEM 02,.COMM.+=8
42300 ;25300 .0056=.0392/7.(THE MAGIC NUM FOR VERT SIZE OF BRACK.) .3136=8*.0392
42400 ;25400 ADD DIST BETWEEN BOTTOM OF STAVES TO HEIGHT OF TOP STAFF
42500 MOVE 2,.COMM.+=9 ; 25500 IF(R6.EQ.0)R6=1.+R7/20.
42600 SETZM .COMM.+=9 ;***** USE P8 FOR WIDTH FACTOR!! *****
42700 SETZM .COMM.+=29 ;J8=0
42800 JUMPN 2,.+3 ;P6=P8; P8=0
42900 FDVR 02,[20.0]
43000 FADRI 02,201400
43100 MOVEM 02,.COMM.+7 ;25600 JA=3
43200 MOVEI 02,3
43300 MOVEM 02,.COMM.+1 ;25700 R4=2.3
43400 MOVE 02,[2.3]
43500 MOVEM 02,.COMM.+5 ;BECAUSE BRACK DOESN'T REALLY GO UP FROM 0 ?!?X*↑
43600 ; 25900 CALL CLEFS
43700 JSA 16,CLEFS ; 26000 RETURN
43800 JRA 16,(16)
43900 I4001: CAIN 2,5 ; 26200 4001 IF(J7.EQ.5)GO TO 4002
44000 JRST I4002 ; J7 IS IN AC2
44100 MOVE 02,.COMM.+=9 ;26300 IF(R8.LE.0)R8=.8
44200 JUMPG 02,.+3 ;NO NEG. NUMBS!!!! 2/78
44300 MOVE 02,[0.8]
44400 MOVEM 02,.COMM.+=9 ;26400 C P8 CAN SET SIZE OF DASH
44500 MOVE 02,[5.96] ; 26402 RZ=5.96*RSTJ2
44600 FMPR 02,STF+=8
44700 MOVEM 02,ALF+=18 ; 26405 RJ=R8*RZ
44800 FMPR 02,.COMM.+=9
44900 MOVEM 02,ALF+=11 ;26410 RZ=R9*RZ
45000 MOVE 3,.COMM.+=10
45100 FMPRM 3,ALF+=18
45200 SKIPG .COMM.+=10 ; 26420 IF(R9.LE.0)RZ=RJ
45300 MOVEM 02,ALF+=18
45400 ;26430 P9 SETS SPACE BETWEEN DASHES. (CAN BE DIFFERENT FROM P8)
45500 ; 26440 R8=RJ
45600 MOVEM 02,.COMM.+=9 ;26450 R9=RZ
45700 MOVE 02,ALF+=18
45800 MOVEM 02,.COMM.+=10 ;26500 RD=RD+POS
45900 MOVE 02,POSI+=9
46000 FADRB 02,ALF+7 ; 26600 RJX=RD
46100 MOVEM 02,ALF+=10 ; 27100 RJY=RD
46200 MOVEM 02,BM+2
46300 ;26700 =1 =DASHES, P6=P3=VERTICAL; P4=P5=HORIZ.; OTHERWISE SLOPE.
46400 JSA 16,RHORZ ; 26800 J6=ROFF(RHORZ(R6))
46500 JUMP .COMM.+7
46600 MOVE 4,0
46700 JSA 16,ROFF
46800 JUMP 4
46900 KIFIX 0,0
47000 MOVEM 00,.COMM.+=27
47100 SUBM 0,.COMM.+=24 ; 26900 J3=J6-J3
47200 ; 27000 J4=J5-J4
47300 MOVE 2,.COMM.+=6 ;NOW J4=R5-R4 (J4 IS FLTING PT)
47400 FSBR 2,.COMM.+5
47500 MOVEM 2,.COMM.+=25 ; CHECKS FOR TILT, USED LATER
47600 FLTR 0,.COMM.+=27 ;MOVE .COMM.+=27 27200 C SAVE FOR THICK LINES
47700 ; TLC 0,232000 ; 27300 RA=J6
47800 ; FADR 0,0
47900 MOVEM 00,BM ; 27400 C RA IS HORIZ. GOAL FOR DASHES
48000 ; 27500 402 OLDTOP=POS+R5*RST7
48100 MOVE 02,ALF+3 ; LABEL 402 NOT USED
48200 FMPR 02,.COMM.+6
48300 FADR 02,POSI+=9
48400 MOVEM 02,OLDTOP ; 27600 IF(J4.EQ.0)GO TO 41
48500 MOVE 3,.COMM.+=25
48600 JUMPE 3,I41 ; 27700 RH=OLDTOP-RD
48700 ; 27800 C TOTAL HEIGHT DIFF.
48800 MOVN 3,.COMM.+4 ; 27900 RX=RA-R3
48900 FADR 3,BM
49000 MOVEM 3,ALF+=8 ; 28000 C TOTAL LENGTH DIFF.
49100 FSBR 2,ALF+7 ; 28100 RH=RH/RX
49200 FDVR 02,ALF+=8
49300 MOVEM 02,RH# ; 28200 41 L=3
49400 I41: MOVEI 02,3
49500 MOVEM 02,ALF+=12 ;28300 K=2
49600 MOVEI 02,2
49700 MOVEM 02,ALF+=13 ;28400 416 CALL LINES(R3Q,ALF+7,ALF+=12)
49800 I416: JSA 16,LINES
49900 JUMP ALF+5
50000 JUMP ALF+7
50100 JUMP ALF+=12 ; 28405 IF(J3.EQ.0)GO TO 412
50200 MOVE 02,.COMM.+=24
50300 JUMPE 02,I412 ;28407 C JUMP FOR VERT. DASH
50400 MOVE 3,ALF+5 ;(R3Q) ;28410 IF(J3.GT.0)GO TO 422
50500 JUMPG 02,I422 ; 28420 IF(R3Q.LE.RA)GO TO 413
50600 CAMG 3,BM
50700 JRST I413 ; 28425 C THIS IF P6 IS LESS THAN P3
50800 ; 28430 R3Q=R3Q-RJ
50900 MOVN 02,ALF+=11 ; 28440 GO TO 423
51000 JRST I423 ; 28500 422 IF(R3Q.GE.RA)GO TO 413
51100 I422: CAML 3,BM
51200 JRST I413 ; 28600 C JUMP IF ALL DONE
51300 MOVE 02,ALF+=11 ; 28700 R3Q=R3Q+RJ
51400 I423: FADRB 02,ALF+5 ;28710 423 IF(J4.NE.0)RD=RJY+RH*(R3Q-R3)
51500 MOVE 3,.COMM.+=25 ; J4 HAS TILT(SEE I402 -)
51600 JUMPE 3,.+5
51700 FSBR 02,.COMM.+4
51800 FMPR 02,RH
51900 FADR 02,BM+2
52000 MOVEM 02,ALF+7 ;28720 FINDS HEIGHT OF RIGHT SIDE OF SLOPE
52100 I414: MOVE 2,ALF+=12 ; 28800 414 CALL EXCH(L,ALF+=13)
52200 EXCH 2,ALF+=13
52300 MOVEM 2,ALF+=12
52400 MOVE 2,ALF+=11 ; 28810 CALL EXCH(RJ,ALF+=18)
52500 EXCH 2,ALF+=18
52600 MOVEM 2,ALF+=11 ; 28820 C EXCH. SPACE AND DASH SIZE.
52700 JRST I416 ; 28900 GO TO 416
52800 I412: MOVE 1,ALF+7 ;28950 412 IF(J4.GT.0)GO TO 424
52900 MOVE 02,.COMM.+=25
53000 JUMPG 02,I424 ; 28960 IF(RD.LE.OLDTOP)GO TO 413
53100 CAMG 1,OLDTOP
53200 JRST I413 ; 28970 RD=RD-RJ
53300 MOVN 02,ALF+=11
53400 FADRM 02,ALF+7 ; 28980 C THIS IF P5 IS LESS THAN P4.
53500 JRST I414 ; 28990 GO TO 414
53600 I424: CAML 1,OLDTOP ;29000 424 IF(RD.GE.OLDTOP)GO TO 413
53700 JRST I413 ; 29100 C JUMP IF DONE
53800 MOVE 02,ALF+=11 ; 29200 RD=RD+RJ
53900 FADRM 02,ALF+7 ; 29300 GO TO 414
54000 JRST I414 ; 29400 413 IF(J10.GT.0)GO TO 420
54100 I413: MOVE 02,J10
54200 JUMPG 02,I420
54300 SKIPN .COMM.+=32 ; 29410 IF(J11.EQ.0)RETURN
54400 JRA 16,(16)
54500 SKIPGE .COMM.+=24 ; 29415 IF(J3)RJ=-RJ
54600 MOVNS 00,ALF+=11 ; 29420 IF(L.EQ.3)R3Q=R3Q-RJ
54700 MOVEI 02,3
54800 CAME 02,ALF+=12
54900 JRST .+3
55000 MOVN 02,ALF+=11
55100 FADRM 02,ALF+5 ; 29430 RX=R8
55200 MOVE 02,.COMM.+=9
55300 MOVEM 02,ALF+=8
55400 SKIPGE .COMM.+=32 ; 29440 IF(J11)RX=-RX
55500 MOVNS 00,ALF+=8 ;29450 CALL LINX(R3Q,ALF+7,ALF+5,ALF+7+RX)
55600 MOVE 14,ALF+7
55700 FADR 14,ALF+=8
55800 JSA 16,LINX
55900 JUMP ALF+5
56000 JUMP ALF+7
56100 JUMP ALF+5
56200 JUMP 14 ; 29460 C PUTS BRACK END ON DASHED LINE. (P11=1 OR -1)
56300 ; 29470 RETURN
56400 JRA 16,(16) ; 29500 C NEXT FOR THICK DASHES
56500 ; 29600 420 J10=J10-1
56600 I420: SOS J10 ; 29650 RJ=1./DIS
56700 MOVE 3,PLTR+3 ;AC3=XDIS
56800 ;; FDVR 3,PLTR+2 ; 29700 IF(J3.EQ.0)GO TO 415
56900 MOVE 02,.COMM.+=24
57000 JUMPE 02,I415 ; 29800 R3Q=R3
57100 MOVE 02,.COMM.+4
57200 MOVEM 02,ALF+5 ; 29900 RJY=RJY+RJ
57300 FADRB 3,BM+2 ;29950 RD=RJY
57400 MOVEM 3,ALF+7 ;30000 GO TO 417
57500 JRST I417 ; 30100 415 R3Q=R3Q+RJ
57600 I415: FADRM 3,ALF+5 ; 30200 RD=RJX
57700 MOVE 02,ALF+=10
57800 MOVEM 02,ALF+7 ;30210 417 RJ=R8
57900 I417: MOVE 02,.COMM.+=9
58000 MOVEM 02,ALF+=11 ; 30220 RZ=R9
58100 MOVE 02,.COMM.+=10
58200 MOVEM 02,ALF+=18 ; 30230 C FOR THICK DASHES.
58300 ; 30300 GO TO 41
58400 JRST I41 ; 30600 407 RX=RD+POS
58500 I407: MOVE 02,ALF+7
58600 FADR 02,POSI+=9
58700 MOVEM 02,ALF+=8 ; 30700 OLDTOP=R5*RST7+POS
58800 MOVE 02,ALF+3
58900 FMPR 02,.COMM.+6
59000 FADR 02,POSI+=9
59100 MOVEM 02,OLDTOP
59200 MOVMS .COMM.+=9 ;***** R8=ABS(R8) NO NEG, TOLERATED!!! 2/78
59300 MOVE 3,.COMM.+=28 ; 30800 IF(J7.EQ.3)GO TO 140
59400 CAIN 3,3
59500 JRST I140 ; 30900 CALL NOZERO(R9)
59600 JSA 16,NOZERO
59700 JUMP .COMM.+=10
59800 CAMN 3,[-1] ; 31000 IF(J7.EQ.-1)GO TO 408
59900 JRST I408
60000 ; 31100 C FOR 'TR' J7=-2, 'ARPEGG' J7=-1, STRAIGHT LINES J7=0
60100 ; 31200 CC WHY THE IFIX???? RJX=IFIX(RHORZ(R6))
60200 JSA 16,RHORZ ; 31300 RJX=IFIX(ROFF(RHORZ(R6)))
60300 JUMP .COMM.+7
60400 MOVE 4,
60500 JSA 16,ROFF
60600 JUMP 4
60700 KIFIX 0,0 ;MOVE 4,
60800 ; JSA 16,IFIX
60900 ; JUMP 4
61000 FLTR 0,0 ;TLC 0,232000
61100 ;FADR 0,0
61200 MOVEM 00,ALF+=10
61300 ;31400 C ALL THIS CRAP SO IT WILL MATCH UP WITH P3 WHEN NECESSARY.
61400 MOVE 02,.COMM.+=28 ;31500 IF(J7.EQ.0)GO TO 42
61500 JUMPE 3,I42 ; 31600 OLDTOP=R9*RST7+RX
61600 MOVE 02,ALF+3
61700 FMPR 02,.COMM.+=10
61800 FADR 02,ALF+=8
61900 MOVEM 02,OLDTOP ; 31700 CALL NOZERO(R8)
62000 JSA 16,NOZERO
62100 JUMP .COMM.+=9 ; 31800 4041 RZ=RX
62200 I4041: MOVE 02,ALF+=8
62300 MOVEM 02,ALF+=18 ; 31900 RH=OLDTOP
62400 MOVE 14,OLDTOP
62500 MOVEM 14,RH ;32000 C SAVE FOR THICK WIGGLES
62600 JSA 16,LINES ;32100 CALL LINES(R3Q,ALF+=8,3)
62700 JUMP ALF+5
62800 JUMP ALF+=8
62900 JUMP [3] ; 32200 C DRAWS STRAIGHT LINES. ETC.
63000 MOVE 02,ALF+5 ; 32300 R9=R3Q
63100 MOVEM 02,.COMM.+=10 ;32400 RJ=OLDTOP
63200 MOVEM 14,ALF+=11 ; 32500 RW=3.*RSTJ2*R8
63300 MOVSI 02,202600
63400 FMPR 02,STF+=8
63500 FMPR 02,.COMM.+=9
63600 MOVEM 02,ALF+=9 ; 32600 RA=RW*2.5
63700 MOVSI 02,202500
63800 FMPR 02,ALF+=9
63900 MOVEM 02,BM ; P8=HORZ. WIGGLE SIZE; P9=VERT. SIZE
64000 I404: MOVE 02,BM ; 32800 404 R9=R9+RA
64100 FADRM 02,.COMM.+=10 ;32900 CALL LINES(R9,ALF+=11,2)
64200 JSA 16,LINES
64300 JUMP .COMM.+=10
64400 JUMP ALF+=11
64500 JUMP [2] ; 33000 R9=R9+RW
64600 MOVE 14,ALF+=9
64700 FADRB 14,.COMM.+=10 ;33100 CALL LINES(R9,ALF+=11,2)
64800 JSA 16,LINES
64900 JUMP .COMM.+=10
65000 JUMP ALF+=11
65100 JUMP [2]
65200 I405: MOVE ALF+=8 ; 33200 405 CALL EXCH(RX,ALF+=11)
65300 EXCH ALF+=11
65400 MOVEM ALF+=8
65500 CAMGE 14,ALF+=10 ; 33300 IF(R9.LT.RJX)GO TO 404
65600 JRST I404
65700 SKIPG .COMM.+=31 ; 33400 IF(J10.LE.0)RETURN
65800 JRA 16,(16)
65900 MOVE 2,PLTR+3 ;OLDTOP=XDIS
66000 MOVEM 02,OLDTOP ; 33500 RX=RZ+OLDTOP
66100 FADR 02,ALF+=18
66200 MOVEM 02,ALF+=8 ; 33600 OLDTOP=RH+OLDTOP
66300 MOVE 02,RH
66400 FADRM 02,OLDTOP
66500 SOS .COMM.+=31 ; 33700 J10=J10-1
66600 JRST I4041 ; 33800 GO TO 4041
66700 ; 33900 C P10= + NUM OF THICKNESSES TO WIGGLE
66800 I408: MOVE 02,ALF+=8 ;34100 408 IF(RX.GT.OLDTOP)CALL EXCH(RX,OLDTOP)
66900 CAMLE 2,OLDTOP
67000 EXCH 2,OLDTOP
67100 MOVEM 2,ALF+=8 ; 34200 RZ=R9*RSTJ2*5.96
67200 MOVE 02,STF+=8
67300 FMPR 02,.COMM.+=10
67400 FMPR 02,[5.96]
67500 MOVEM 02,ALF+=18 ;USE P9 TO SET WIGGLE WIDTH. P8 TO SET HGT.
67600 JSA 16,NOZERO ; 34400 CALL NOZERO(R8)
67700 JUMP .COMM.+=9 ; 34500 RD=R8*RST7*.5
67800 MOVE 02,ALF+3
67900 FMPR 02,.COMM.+=9
68000 FSC 02,777777
68100 MOVEM 02,ALF+7 ; 34600 RJ=RD
68200 MOVEM 02,ALF+=11 ; 34700 IF(RD.LT.1.)RD=1.
68300 MOVSI 02,201400
68400 CAMLE 02,ALF+7
68500 MOVEM 2,ALF+7 ; 34800 421 R9=RX
68600 I421: MOVE 02,ALF+=8
68700 MOVEM 02,.COMM.+=10 ;34900 RW=R3Q
68800 MOVE 02,ALF+5
68900 MOVEM 02,ALF+=9 ; 35000 RA=RZ+R3Q
69000 FADR 02,ALF+=18
69100 MOVEM 02,BM ;35100 CALL LINES(RW,.COMM.+=10,3)
69200 JSA 16,LINES
69300 JUMP ALF+=9
69400 JUMP .COMM.+=10
69500 JUMP [3] ; 35200 410 R9=R9+RJ
69600 I410: MOVE 02,ALF+=11
69700 FADRM 02,.COMM.+=10 ;35300 CALL LINES(RA,.COMM.+=10,2)
69800 JSA 16,LINES
69900 JUMP BM
70000 JUMP .COMM.+=10
70100 JUMP [2] ; 35400 R9=R9+RD
70200 MOVE 02,ALF+7
70300 FADRM 02,.COMM.+=10 ;35500 CALL LINES(RA,.COMM.+=10,2)
70400 JSA 16,LINES
70500 JUMP BM
70600 JUMP .COMM.+=10
70700 JUMP [2]
70800 MOVE BM ; 35600 CALL EXCH(RA,ALF+=9)
70900 EXCH ALF+=9
71000 MOVEM BM ; 35700 IF(R9.LT.OLDTOP)GO TO 410
71100 MOVE 02,OLDTOP
71200 CAMLE 02,.COMM.+=10
71300 JRST I410
71400 SKIPG .COMM.+=31 ; 35800 IF(J10.LE.0)RETURN
71500 JRA 16,(16) ; 35900 R3Q=R3Q+1./DIS
71600 MOVE 2,PLTR+3 ;XDIS
71700 FADRM 02,ALF+5
71800 SOS .COMM.+=31 ; 36000 J10=J10-1
71900 JRST I421 ; 36100 GO TO 421
72000 JRA 16,(16) ;36200 C VERTICAL WIGGLE P10=+ NUM OF THICKNESSES.
72100 END ; 36300 END